scripts/tests/impact curve test.R

In joakimwallmark/PolyOptimalIRT:

library(ggplot2)

# Surprisals and DSusprisals for 0.01x prob function
surprisal <- function(x) { -log2(0.01*x) }
surprisalinv <- function(x) { -log2(1-0.01*x) }
surprisalderivative <- function(x) { -1/(log(2)*x) }
surprisalderivativeinv <- function(x) { 0.014427/(-0.01*x+1) }

# Same information for all theta (same slope (a))
x <- seq(0, 100, 1)
ggplot(data.frame(x, p = x*0.01, q=1-x*0.01), aes(x=x, y=p)) +
    theme_bw() +
    geom_line() +
    geom_line(col="blue", aes(x=x, y=q))

# corresponding surprisal
surp <- surprisal(x)
surpinv <- surprisalinv(x)
dataf <- data.frame(x, surp, surpinv)
ggplot(dataf, aes(x=x, y=surp)) +
    theme_bw() +
    geom_line() +
    geom_line(col="blue", aes(x=x, y=surpinv))

# surprisal deriv. curves
x <- seq(0, 100, 1)
surpder <- surprisalderivative(x)
surpderinv <- surprisalderivativeinv(x)
dataf2 <- data.frame(x, surpder, surpderinv)
ggplot(dataf2,
       aes(x=x, y=surpder)) +
    theme_bw() +
    geom_line() +
    geom_line(col="blue", aes(x=x, y=surpderinv)) +
    ylim(-3, 3)

# equal impact
(1-0.01*x)*surpderinv
0.01*x*surpder

# information
surpder^2/(x*0.01*(1-x*0.01))